c----------------------------------------------------------------------
c  setupDLL initialises the data shared by the DLL and the front-end,
c  and passes addresses over using callbacks.
c----------------------------------------------------------------------

      subroutine setupDLL
      
c --- variables that are going to be shared with the front-end need
c --- to be in common blocks.

      common /cack/ m,n,iack
      integer *4 m,n,iack
      common /ctrl/ abort
      integer*4 abort

      common /cpush/ ipt, mvec, nvec, irtvec
      integer*4 ipt, mvec(10000), nvec(10000), irtvec(10000)
      
      character*10 a_name
      
c --- pass over the addresses of the variables we're going to share
c --- with the front-end

      abort = 0
      iack = 0
      ipt = 0
      m = 1
      n = 2
      
      a_name = 'm' C
      call setIntAddr(a_name,m)
      a_name = 'n' C
      call setIntAddr(a_name,n)
      a_name = 'iack' C
      call setIntAddr(a_name,iack)
      a_name = 'ipt' C
      call setIntAddr(a_name,ipt)
      a_name = 'abort' C
      call setIntAddr(a_name,abort)

      return
      end
      
c----------------------------------------------------------------------
c  Calculates Ackerman's Function
c
c     if m=0 then n+1
c     else if n=0 then A(m-1,1)
c     else A(m-1, A(m,n-1))
c
c  The recursion depth (and time taken) increases dramatically for
c  quite small changes in m and n..... A(3,6) takes a couple of
c  minutes, while A(4,1) takes a very long time!
c
c  This code was modified from a program given in
c    "Fortran Techniques" by A.Colin Day,
c    Cambridge University Press, 1972
c
c----------------------------------------------------------------------
      subroutine ackerman

      common /cack/ m,n,iack
      integer *4 m,n,iack
      common /cpush/ ipt, mvec, nvec, irtvec
      integer*4 ipt, mvec(10000), nvec(10000), irtvec(10000)
      
      integer*4 push,istat
      character*20 txt
      character*80 title,msg
      
      ipt = 0

      istat = push(m,n,1)
      if (istat.lt.0) goto 50
      
  200 if (mvec(ipt).gt.0) goto 211
      iack = nvec(ipt) + 1
      goto 277
  211 if (nvec(ipt).gt.0) goto 222
      istat = push(mvec(ipt)-1,1,2)
      if (istat.lt.0) goto 50
      
      goto 200
   20 goto 277
  222 istat = push(mvec(ipt), nvec(ipt)-1, 3)
      if (istat.lt.0) goto 50
      
      goto 200
   30 istat = push(mvec(ipt)-1, iack, 4)
      if (istat.lt.0) goto 50
      
      goto 200
   40 continue
  277 irt = irtvec(ipt)
      ipt = ipt-1
      goto (10,20,30,40), irt
      
c --- If PUSH has signalled an error, the code ends up here. A value
c --- of -1 means the stack has overflowed, and in this case, the DLL 
c --- causes a UAE, and brings the program to a halt. We could just as
c --- easily have passed an error flag back to the calling routine.
c --- A value of -99 means that the user has interrupted the
c --- calculation, so we can just return.

   50 continue
      if (istat .eq. -1) then
        txt = 'Stack Overflow!' C
        call bombOut(txt)
      else if (istat .eq. -99) then
        title = 'Ackerman' C
        msg = 'User interrupt' C
        call doMsg(title,msg)
      endif
   
c-----result is in iack      
   10 continue
    
      return
      end
      
c----------------------------------------------------------------------
c  push implements the stack handling for recursive calculation of
c  Ackerman's function.
c----------------------------------------------------------------------

      integer*4 function push (m,n,iret)
      common /cpush/ ipt, mvec, nvec, irtvec
      integer*4 ipt, mvec(10000), nvec(10000), irtvec(10000)

      common /ctrl/ abort
      integer*4 abort

      character*80 buff
      
c --- call WinYield to allow other Windows apps to get a look in...

      call WinYield

c --- check the abort flag - if it is set, return an error.
      
      if (abort.ne.0) then
        push = -99
        return
      endif

c --- else process this call...
      
      ipt = ipt + 1
      if (ipt .le. 10000) then
        if (mod(ipt,10).eq.0) then
          write(buff,'(a13,i5,a1)') 'Stack level: ',ipt,char(0)
          call c_update_window(buff)
        endif
      
        mvec(ipt) = m
        nvec(ipt) = n
        irtvec(ipt) = iret
        push = 0
      else
        push = -1               ! stack overflow
      endif
      return
      end
      
